home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / Command.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-05  |  3.5 KB  |  109 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         Command.lsp
  5. ; RCS:          $Header: Command.lsp,v 1.2 91/10/05 02:27:14 mayer Exp $
  6. ; Description:  Demo of XM_COMMAND_WIDGET_CLASS
  7. ; Author:       Niels Mayer, HPLabs
  8. ; Created:      Sun Feb 10 20:32:15 1991
  9. ; Modified:     Sat Oct  5 02:25:13 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  24. ; makes no representations about the suitability of this software for any
  25. ; purpose.  It is provided "as is" without express or implied warranty.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. (let ()
  29.  
  30. (setq top_w
  31.       (send TOP_LEVEL_SHELL_WIDGET_CLASS :new "command-test"
  32.         :XMN_TITLE        "Command Widget Test"
  33.         :XMN_ICON_NAME    "CmdTest"
  34.         ))
  35.  
  36. (setq command_w
  37.       (send XM_COMMAND_WIDGET_CLASS :new :managed
  38.         "command" top_w
  39.         :XMN_PROMPT_STRING        "Geo-Political choices"
  40.         :XMN_COMMAND        "quagmire"
  41.         :XMN_HISTORY_ITEMS        #("dogma"
  42.                       "cold war"
  43.                       "new world odor"
  44.                       "orwell's 1984"
  45.                       "certain doom"
  46.                       "imperialism"
  47.                       "stupidity"
  48.                       "interventionism")
  49.         :XMN_HISTORY_ITEM_COUNT    6
  50.         :XMN_HISTORY_MAX_ITEMS    10
  51.         :XMN_HISTORY_VISIBLE_ITEM_COUNT 5
  52.         ))
  53.  
  54. (send command_w :set_callback :XmN_command_Changed_Callback 
  55.       '(CALLBACK_WIDGET CALLBACK_REASON CALLBACK_XEVENT CALLBACK_VALUE CALLBACK_LENGTH)
  56.       '(
  57.     (format T "Command Callback occured.\n\twidget=~A;\n\treason=~A;\n\tevent=~A;\n\tvalue=~A;\n\txmstr-length=~A\n"
  58.         CALLBACK_WIDGET
  59.         CALLBACK_REASON
  60.         CALLBACK_XEVENT
  61.         (xm_string_get_l_to_r CALLBACK_VALUE)
  62.         CALLBACK_LENGTH)
  63.     ))
  64.  
  65. (send command_w :set_callback :XmN_command_Entered_Callback
  66.       '(CALLBACK_WIDGET CALLBACK_REASON    CALLBACK_XEVENT CALLBACK_VALUE CALLBACK_LENGTH)
  67.       '(
  68.     (format T "Command Callback occured.\n\twidget=~A;\n\treason=~A;\n\tevent=~A;\n\tvalue=~A;\n\txmstr-length=~A\nHistory Items:"
  69.         CALLBACK_WIDGET
  70.         CALLBACK_REASON
  71.         CALLBACK_XEVENT
  72.         (xm_string_get_l_to_r CALLBACK_VALUE)
  73.         CALLBACK_LENGTH)
  74.  
  75.     (let* ((items_array (send command_w :get_history_items))
  76.            (items_length (length items_array))
  77.            )
  78.       (do ((i 0 (1+ i)))
  79.           ((= i items_length))
  80.           (format t "\t~A\n" (xm_string_get_l_to_r (aref items_array i))))
  81.       )
  82.     ))
  83.  
  84. (send command_w :get_child :DIALOG_COMMAND_TEXT)
  85.  
  86. (send command_w :get_child :DIALOG_HISTORY_LIST)
  87.  
  88. (send command_w :get_child :DIALOG_PROMPT_LABEL)
  89.  
  90. (send command_w :set_value "freedom ")
  91.  
  92. (send command_w :append_value "love ")
  93. (send command_w :append_value "and equality ")
  94.  
  95.  
  96. (let* ((items_array (send command_w :get_history_items))
  97.        (items_length (length items_array))
  98.        )
  99.   (do ((i 0 (1+ i)))
  100.        ((= i items_length))
  101.        (print (xm_string_get_l_to_r (aref items_array i))))
  102.   )
  103.  
  104. (send command_w :error "<<ERROR: invalid choice>>")
  105.  
  106. (send top_w :realize)
  107.  
  108. )
  109.